home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / PROGRAMM / PASCAL / 1372.ZIP / PIBCAT.ARC / PIBCATM.PAS < prev    next >
Pascal/Delphi Source File  |  1988-10-28  |  15KB  |  321 lines
  1. (*----------------------------------------------------------------------*)
  2. (*   Display_MD_Contents --- Display contents of library (.MD) file     *)
  3. (*----------------------------------------------------------------------*)
  4.  
  5. PROCEDURE Display_MD_Contents( MDFileName : AnyStr );
  6.  
  7. (*----------------------------------------------------------------------*)
  8. (*                                                                      *)
  9. (*    Procedure: Display_MD_Contents                                    *)
  10. (*                                                                      *)
  11. (*    Purpose:   Displays contents of a library file (.MD file)         *)
  12. (*                                                                      *)
  13. (*    Calling sequence:                                                 *)
  14. (*                                                                      *)
  15. (*       Display_MD_Contents( MDFileName : AnyStr );                    *)
  16. (*                                                                      *)
  17. (*          MDFileName --- name of .MD file whose contents              *)
  18. (*                         are to be listed.                            *)
  19. (*                                                                      *)
  20. (*    Calls:                                                            *)
  21. (*                                                                      *)
  22. (*       Aside from internal subroutines, these routines are required:  *)
  23. (*                                                                      *)
  24. (*          Dir_Convert_Date_And_Time                                   *)
  25. (*                            --- convert DOS packed date/time to string*)
  26. (*          Open_File         --- open a file                           *)
  27. (*          Close_File        --- close a file                          *)
  28. (*          Entry_Matches     --- Perform wildcard match                *)
  29. (*          Display_Page_Titles                                         *)
  30. (*                            --- Display titles at top of page         *)
  31. (*          DUPL              --- Duplicate a character into a string   *)
  32. (*                                                                      *)
  33. (*----------------------------------------------------------------------*)
  34.  
  35. TYPE
  36.    Array4 = ARRAY[1..4] OF CHAR;
  37.    
  38. (* STRUCTURED *) CONST
  39.    ValidSig : Array4 = 'MDmd'      (* Signature to verify mdcd file     *);
  40.  
  41. (*----------------------------------------------------------------------*)
  42. (*                  Map of MD file entry header                         *)
  43. (*----------------------------------------------------------------------*)
  44.  
  45. TYPE
  46.    MD_Entry_Type = RECORD             (* Header for each compressed file *)
  47.    
  48.                       Signature    : Array4              (* file/header signature (MDmd)      *);
  49.                       ReleaseLevel : BYTE                (* compress version                  *);
  50.                       HeaderType   : BYTE                (* header type. only type 1 for now  *);
  51.                       HeaderSize   : WORD                (* size of this header in bytes      *);
  52.                       UserInfo     : WORD                (* any user info desired             *);
  53.                       Reserved1    : WORD                (* future use and upward compatablty *);
  54.                       Reserved2    : LONGINT             (* future use and upward compatablty *);
  55.                       Reserved3    : ARRAY[1..8] OF BYTE (* future use and upward compatablty *);
  56.                       CompressType : BYTE                (* type of compression               *);
  57.                       OrigFileSize : LONGINT             (* original file size in bytes       *);
  58.                       CompFileSize : LONGINT             (* compressed file size in bytes     *);
  59.                       FileAttr     : WORD                (* original file attribute           *);
  60.                       FileDate     : LONGINT             (* original file date/time           *);
  61.                       FileCRC      : WORD                (* file crc                          *);
  62.                       FileName     : STRING[12]          (* file name                         *);
  63.                       PathName     : DirStr              (* original drive\path               *);
  64.  
  65.                   END;
  66.  
  67. VAR
  68.    MDFile        : FILE                 (* MD file to be read             *);
  69.    MD_Entry      : MD_Entry_Type        (* Header for one file in MD file *);
  70.    MD_Pos        : LONGINT              (* Current byte offset in MD file *);
  71.    Bytes_Read    : INTEGER              (* # bytes read from MD file      *);
  72.    Ierr          : INTEGER              (* Error flag                     *);
  73.    Do_Blank_Line : BOOLEAN              (* TRUE to print blank line       *);
  74.  
  75. (*----------------------------------------------------------------------*)
  76. (*        Get_Next_MD_Entry --- Get next header entry in MD file        *)
  77. (*----------------------------------------------------------------------*)
  78.  
  79. FUNCTION Get_Next_MD_Entry( VAR MDEntry : MD_Entry_Type;
  80.                             VAR Error   : INTEGER ) : BOOLEAN;
  81.  
  82. (*----------------------------------------------------------------------*)
  83. (*                                                                      *)
  84. (*    Function:  Get_Next_MD_Entry                                      *)
  85. (*                                                                      *)
  86. (*    Purpose:   Gets header information for next file in MD file       *)
  87. (*                                                                      *)
  88. (*    Calling sequence:                                                 *)
  89. (*                                                                      *)
  90. (*       OK := Get_Next_MD_Entry( VAR MDEntry : MD_Entry_Type;          *)
  91. (*                                VAR Error   : INTEGER );              *)
  92. (*                                                                      *)
  93. (*          MDEntry --- Header data for next file in MD file            *)
  94. (*          Error   --- Error flag                                      *)
  95. (*          OK      --- TRUE if header successfully found, else FALSE   *)
  96. (*                                                                      *)
  97. (*----------------------------------------------------------------------*)
  98.  
  99. BEGIN (* Get_Next_MD_Entry *)
  100.                                    (* Assume no error to start *)
  101.    Error := 0;
  102.                                    (* Except first time, move to     *)
  103.                                    (* next supposed header record in *)
  104.                                    (* MD file.                       *)
  105.  
  106.    IF ( MD_Pos <> 0 ) THEN
  107.       Seek( MDFile, MD_Pos );
  108.  
  109.                                    (* Read in the file header entry. *)
  110.  
  111.    BlockRead( MDFile, MDEntry, SizeOf( MD_Entry ), Bytes_Read );
  112.    Error := 0;
  113.                                    (* If we didn't read enough, assume     *)
  114.                                    (* it's the end of the file.            *)
  115.  
  116.    IF ( Bytes_Read <  SizeOf( MD_Entry ) ) THEN
  117.       Error := End_Of_File
  118.                                    (* Check signature.  If wrong, then    *)
  119.                                    (* file is bad or not an MD file at    *)
  120.                                    (* all.                                *)
  121.                                    
  122.    ELSE IF ( MDEntry.Signature <> ValidSig ) THEN
  123.       Error := Format_Error
  124.    ELSE                            (* Header looks ok -- we got    *)
  125.                                    (* the entry data.  Position to *)
  126.                                    (* next header.                 *)
  127.       WITH MDEntry DO
  128.          MD_Pos := MD_Pos + HeaderSize + CompFileSize;
  129.  
  130.                                     (* Report success/failure to calling *)
  131.                                     (* routine.                          *)
  132.  
  133.    Get_Next_MD_Entry := ( Error = 0 );
  134.  
  135. END   (* Get_Next_MD_Entry *);
  136.  
  137. (*----------------------------------------------------------------------*)
  138. (*         Display_MD_Entry --- Display MD file header entry            *)
  139. (*----------------------------------------------------------------------*)
  140.  
  141. PROCEDURE Display_MD_Entry( MD_Entry : MD_Entry_Type );
  142.  
  143. VAR
  144.    SDate      : STRING[10];
  145.    STime      : STRING[12];
  146.    I          : INTEGER;
  147.    FName      : AnyStr;
  148.    
  149. BEGIN (* Display_MD_Entry *)
  150.  
  151.    WITH MD_Entry DO
  152.       BEGIN
  153.                                    (* Pick up file name              *)
  154.          FName := FileName;                          
  155.                                    (* See if this file matches the   *)
  156.                                    (* entry spec wildcard.  Exit if  *)
  157.                                    (* not.                           *)
  158.  
  159.          IF Use_Entry_Spec THEN
  160.             IF ( NOT Entry_Matches( FName ) ) THEN
  161.                EXIT;
  162.                                    (* Make sure room on current page *)
  163.                                    (* for this entry name.           *)
  164.                                    (* If enough room, print blank    *)
  165.                                    (* line if requested.  This will  *)
  166.                                    (* only happen for first file.    *)
  167.          IF Do_Blank_Line THEN
  168.             BEGIN
  169.                IF ( Lines_Left < 2 ) THEN
  170.                   Display_Page_Titles
  171.                ELSE
  172.                   BEGIN
  173.                      WRITELN( Output_File );
  174.                      DEC( Lines_left );
  175.                   END;
  176.                Do_Blank_Line := FALSE;
  177.             END
  178.          ELSE
  179.             IF ( Lines_Left < 1 ) THEN
  180.                Display_Page_Titles;
  181.  
  182.                                    (* Add '. ' to front if we're     *)
  183.                                    (* expanding MDs in main listing  *)
  184.          IF Expand_Libs_In THEN
  185.             Fname := '. ' + Fname;
  186.  
  187.                                    (* Get date and time of creation *)
  188.  
  189.          Dir_Convert_Date_And_Time( FileDate , SDate , STime );
  190.  
  191.                                    (* Write out file name, length, date, time *)
  192.  
  193.          WRITE( Output_File , Left_Margin_String, '      ' , FName );
  194.  
  195.          FOR I := LENGTH( FName ) TO 14 DO
  196.             WRITE( Output_File , ' ' );
  197.  
  198.          WRITE  ( Output_File , OrigFileSize:8, '  ' );
  199.          WRITE  ( Output_File , SDate, '  ' );
  200.          WRITE  ( Output_File , STime );
  201.  
  202.                                    (* Display long file name if requested *)
  203.  
  204.          IF Show_Long_File_Names THEN
  205.             IF ( PathName <> '' ) THEN
  206.                BEGIN
  207.                   WRITE( Output_File , '  ', PathName );
  208.                   WRITE( Output_File , FileName );
  209.                END;
  210.             
  211.                                    (* Terminate output line *)
  212.          WRITELN( Output_File );
  213.  
  214.                                    (* Count lines left on page *)
  215.          IF Do_Printer_Format THEN
  216.             DEC( Lines_Left );
  217.  
  218.                                    (* Increment total entry count *)
  219.  
  220.          INC( Total_Entries );
  221.  
  222.                                    (* Increment total space used  *)
  223.  
  224.          Total_ESpace := Total_ESpace + OrigFileSize;
  225.  
  226.       END;
  227.  
  228. END (* Display_MD_Entry *);
  229.  
  230. (*----------------------------------------------------------------------*)
  231.  
  232. BEGIN (* Display_MD_Contents *)
  233.  
  234.                                    (* Set left margin spacing *)
  235.  
  236.    Left_Margin_String := Left_Margin_String + DUPL( ' ' , Library_Indent );
  237.  
  238.                                    (* Set file title *)
  239.  
  240.    File_Title := Left_Margin_String + ' MD file: ' + MDFileName;
  241.  
  242.                                    (* Display MD file's name *)
  243.    IF Do_Printer_Format THEN
  244.       IF ( Lines_Left < 3 ) THEN
  245.          Display_Page_Titles;
  246.                                    (* If we're listing contents at end  *)
  247.                                    (* of directory, print MD file name. *)
  248.                                    (* Do_Blank_Line flags whether we    *)
  249.                                    (* need to print blank line in entry *)
  250.                                    (* lister subroutine.  If listing    *)
  251.                                    (* inline, then it's true for the    *)
  252.                                    (* first file; otherwise it's false. *)
  253.                                    (* This is to prevent unnecessary    *)
  254.                                    (* blank lines in output listing     *)
  255.                                    (* when no files are selected from   *)
  256.                                    (* a given MD file.                  *)
  257.    IF ( NOT Expand_Libs_In ) THEN
  258.       BEGIN
  259.          WRITELN( Output_File ) ;
  260.          WRITE  ( Output_File , File_Title );
  261.          DEC( Lines_Left , 2 );
  262.          Do_Blank_Line := FALSE;
  263.       END
  264.    ELSE
  265.       Do_Blank_Line := TRUE;
  266.                                    (* Try opening MD file for processing *)
  267.  
  268.    Open_File( MDFileName , MDFile, MD_Pos, Ierr );
  269.  
  270.                                    (* Issue error message if open fails *)
  271.    IF ( Ierr <> 0 ) THEN
  272.       BEGIN
  273.          WRITELN( Output_File ,
  274.                   DUPL( ' ' , MAX( 0 , MIN( 12 , 13 - LENGTH( MDFileName ) ) ) ),
  275.                   '     Can''t open .MD file ',MDFileName );
  276.          IF Do_Printer_Format THEN
  277.             BEGIN
  278.                DEC( Lines_Left );
  279.                IF ( Lines_Left < 1 ) THEN
  280.                   Display_Page_Titles;
  281.             END;
  282.          EXIT;
  283.       END
  284.    ELSE IF ( NOT Expand_Libs_In ) THEN
  285.       BEGIN
  286.  
  287.          WRITELN( Output_File );
  288.          WRITELN( Output_File );
  289.                                    (* Count lines left on page *)
  290.          IF Do_Printer_Format THEN
  291.             DEC( Lines_Left );
  292.  
  293.       END;
  294.                                    (* Loop over entries in MD file *)
  295.  
  296.    WHILE( Get_Next_MD_Entry( MD_Entry , Ierr ) ) DO
  297.       Display_MD_Entry( MD_Entry );
  298.  
  299.                                    (* Print blank line after last entry   *)
  300.                                    (* in MD file, if we're expanding      *)
  301.                                    (* MD files right after listing them,  *)
  302.                                    (* but only if MD file had any entries *)
  303.                                    (* listed.                             *)
  304.  
  305.    IF ( Expand_Libs_In AND ( NOT Do_Blank_Line ) ) THEN
  306.       BEGIN
  307.          WRITELN( Output_File );
  308.          IF Do_Printer_Format THEN
  309.             DEC( Lines_Left );
  310.       END;
  311.                                    (* Close MD file *)
  312.    Close_File( MDFile );
  313.                                    (* Restore previous left margin spacing *)
  314.  
  315.    Left_Margin_String := DUPL( ' ' , Left_Margin );
  316.  
  317.                                    (* No file title *)
  318.    File_Title := '';
  319.  
  320. END   (* Display_MD_Contents *);
  321.